home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / os2 / lxlt113.zip / SOURCES / UNLOCK.PAS < prev   
Pascal/Delphi Source File  |  1996-05-07  |  5KB  |  200 lines
  1. uses  os2base, miscUtil, Helpers, strOp, Crt, Dos;
  2. const Version   = '1.0.1';
  3.       Recurse   : boolean = _OFF;
  4.       Pause     : boolean = _OFF;
  5.       Verbose   : boolean = _ON;
  6.  
  7. var   OldExit   : Procedure;
  8.       fNames    : pDarray;
  9.       allDone   : boolean;
  10.  
  11. Procedure Stop(eCode : Byte);
  12. begin
  13.  case eCode of
  14.   1,2 : begin
  15.          if eCode = 2
  16.           then begin
  17.                 TextAttr := $0C;
  18.                 Writeln('├ Invalid switch - see help below for details');
  19.                end;
  20.          TextAttr := $07;
  21.          Writeln('├ Usage: unLock [FileMask1] {...FileMask2} {/EPVH?}');
  22.          Writeln('├ /E{+|-} r[E]cursive (+) file search through subdirectories');
  23.          Writeln('├ /P{+|-} Enable (+) or disable (-) pause before each file');
  24.          Writeln('├ /V{+|-} Verbose (show a lot of additional information)');
  25.          Writeln('├ /?,/H   Show this help screen');
  26.          Writeln('├┤Default: /E- /P- /V+');
  27.          TextAttr := $08;
  28.          Writeln('└┤Example: unLock d:\*.exe d:\*.dll /e');
  29.         end;
  30.  end;
  31.  Halt(eCode);
  32. end;
  33.  
  34. Function ParmHandler(var S : string) : Byte;
  35. var I : Longint;
  36.  
  37. Function Enabled : boolean;
  38. begin
  39.  Enabled := _ON;
  40.  if length(S) = 1
  41.   then exit
  42.   else
  43.  if (S[2] in ['+','-'])
  44.   then ParmHandler := 2
  45.   else
  46.  if (S[2] in [' ','/'])
  47.   then exit
  48.   else Stop(2);
  49.  if S[2] = '-' then Enabled := _OFF;
  50. end;
  51.  
  52. begin
  53.  ParmHandler := 1;
  54.  case upCase(S[1]) of
  55.   '?',
  56.   'H' : Stop(1);
  57.   'E' : Recurse := Enabled;
  58.   'P' : Pause := Enabled;
  59.   'V' : Verbose := Enabled;
  60.   else Stop(2);
  61.  end;
  62. end;
  63.  
  64. Function NameHandler(var S : string) : Byte;
  65. var I     : Longint;
  66.     Quote : boolean;
  67. begin
  68.  I := 0;
  69.  if S[1] = '"' then begin Quote := _ON; Delete(S, 1, 1); end else Quote := _OFF;
  70.  While (I < length(S)) and ((S[succ(I)] > ' ') or Quote) do
  71.   if Quote and (S[succ(I)] = '"')
  72.    then break
  73.    else Inc(I);
  74.  fNames^.AddItem(NewStr(Copy(S, 1, I)));
  75.  Inc(I, byte(Quote));
  76.  NameHandler := I;
  77. end;
  78.  
  79. Procedure MyExitProc;
  80. begin
  81.  Write(#13);
  82.  TextAttr := $07; ClrEOL;
  83.  OldExit;
  84. end;
  85.  
  86. Function Ask(const Q,A : string) : byte;
  87. var ch  : char;
  88. begin
  89.  TextAttr := $02;
  90.  Write('└ ', Q, ' ');
  91.  repeat
  92.   ch := upCase(ReadKey);
  93.   if First(ch, A) <> 0
  94.    then begin
  95.          Ask := First(ch, A);
  96.          break;
  97.         end;
  98.  until _OFF;
  99.  Writeln(Ch,#13'├');
  100. end;
  101.  
  102. Procedure ProcessFile(fName : string);
  103. var   _d    : DirStr;
  104.       _n    : NameStr;
  105.       _e    : ExtStr;
  106.       F     : File;
  107.  
  108. Procedure NotLocked;
  109. begin
  110.  if Verbose
  111.   then begin Write(' not locked'); textAttr := $0B; Writeln(#13'├'); end
  112.   else begin Write(#13); ClrEOL; end;
  113. end;
  114.  
  115. begin
  116.  if length(fName) >= 255 then exit;
  117.  fSplit(fName, _d, _n, _e);
  118.  textAttr := $0B; ClrEOL; Write('└ Processing file ', Copy(_n + _e, 1, 28));
  119.  FileMode := open_share_DenyReadWrite or open_access_ReadOnly;
  120.  Assign(F, fName); Reset(F, 1);
  121.  if ioResult = 0
  122.   then begin
  123.         Close(F); NotLocked;
  124.         Exit;
  125.        end;
  126.  fName[succ(length(fName))] := #0; Inc(byte(fName[0]));
  127.  case DosReplaceModule(@fName[1], nil, nil) of
  128.   0 : begin
  129.        textAttr := $0A; Write(' unlocked');
  130.        textAttr := $0B; Writeln(#13'├');
  131.       end;
  132.   2 : NotLocked;
  133.  else begin
  134.        textAttr := $0C; Write(' sharing violation');
  135.        textAttr := $0B; Writeln(#13'├');
  136.       end
  137.  end;
  138. end;
  139.  
  140. Procedure ProcessFiles(const fN : string; Level : Longint);
  141. var sr : SearchRec;
  142.     _d : DirStr;
  143.     _n : NameStr;
  144.     _e : ExtStr;
  145.     nf : Longint;
  146. begin
  147.  fSplit(fN, _d, _n, _e);
  148.  FindFirst(fN, Archive or Hidden or SysFile, sr);
  149.  if (DosError <> 0) and (Level = 0) and (not Recurse)
  150.   then begin
  151.         textAttr := $0C;
  152.         Writeln('├ Cannot find such files: ', fN);
  153.        end;
  154.  nf := 0;
  155.  While (DosError = 0) and (not allDone) do
  156.   begin
  157.    if Pause
  158.     then case Ask('File ' + sr.Name + ': [P]rocess, [S]kip or [A]bort?', 'PSA') of
  159.           2 : sr.Name := '';
  160.           3 : begin allDone := _ON; break; end;
  161.          end;
  162.    if (sr.Name <> '') then ProcessFile(_d + sr.Name);
  163.    FindNext(sr);
  164.   end;
  165.  FindClose(sr);
  166.  if allDone or not Recurse then Exit;
  167.  if nf = 0 then begin textAttr := $0B; Write('└ ', _d); ClrEOL; Write(#13); end;
  168.  FindFirst(_d + '*.*', Archive or Hidden or SysFile or Directory, sr);
  169.  While (dosError = 0) and (not allDone) do
  170.   begin
  171.    if (sr.Attr and Directory <> 0) and (sr.Name[1] <> '.')
  172.     then ProcessFiles(_d + sr.Name + '\' + _n + _e, succ(Level));
  173.    FindNext(sr);
  174.   end;
  175.  FindClose(sr);
  176. end;
  177.  
  178. var I : Longint;
  179.  
  180. begin
  181.  TextAttr := $0F;
  182.  Writeln('┌[ unLock ]──────────────────────────────[ Version '+Version+' ]┐');
  183.  Writeln('├ Copyright 1996 by FRIENDS software ─ No rights reserved ┘');
  184.  TextAttr := $07;
  185.  @OldExit := ExitProc; ExitProc := @MyExitProc;
  186.  New(fNames, Init(8));
  187.  ParseCommandLine(#1, ParmHandler, NameHandler);
  188.  if (fNames^.numItems = 0) then Stop(1);
  189.  
  190.  For I := 1 to fNames^.numItems do
  191.   begin
  192.    ProcessFiles(pString(fNames^.GetItem(I))^, 0);
  193.    if allDone then break;
  194.   end;
  195.  
  196.  TextAttr := $01; ClrEOL;
  197.  Writeln('└┤Done');
  198. end.
  199.  
  200.